home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MATH / MATH1 / SORT-Q-R.LIB < prev    next >
Text File  |  1985-04-03  |  1KB  |  58 lines
  1.  
  2.  
  3. { --> 180}
  4. procedure {quick} sort(var x: ary; n: integer);
  5. { a RECURSIVE sorting routine }
  6. { Adapted from 'The design of Well-Structured and Correct Programs',
  7.     S. Alagic, Springer-Verlag, 1978 }
  8.  
  9.  
  10. procedure qsort(var x: ary; m,n: integer);
  11. var    i,j    : integer;
  12.  
  13.  
  14. procedure partit(var a: ary; var i,j: integer; left,right: integer);
  15. var    pivot    : real;
  16.  
  17. procedure swap(var p,q: real);
  18. var    hold    : real;
  19. begin
  20.   hold:=p;
  21.   p:=q;
  22.   q:=hold
  23. end;        { swap }
  24.  
  25. begin
  26.   pivot:=a[(left+right)div 2];
  27.   i:=left;
  28.   j:=right;
  29.   while i<=j do
  30.     begin
  31.       while a[i]<pivot do
  32.     i:=i+1;
  33.       while pivot<a[j] do
  34.     j:=j-1;
  35.       if i<=j then
  36.     begin
  37.       swap(a[i],a[j]);
  38.       i:=i+1;
  39.       j:=j-1
  40.     end
  41.       end    { while }
  42.   end    { partit }
  43.  
  44. begin        { q-sort }
  45.   if m<n then
  46.     begin
  47.       partit(x,i,j,m,n);    { divide in two }
  48.       qsort(x,m,j);        { sort left part }
  49.       qsort(x,i,n)        { sort right part }
  50.     end
  51. end;        { QSORT }
  52.  
  53. begin    { sort }
  54.   qsort(x,1,n)
  55. end;        { SORT }
  56.  
  57.  
  58.